home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / cmds / perl / dist / usub / pager < prev    next >
Encoding:
Text File  |  1991-06-10  |  3.3 KB  |  191 lines
  1. #!./curseperl
  2.  
  3. eval <<'EndOfMain';   $evaloffset = __LINE__;
  4.  
  5.     $SIG{'INT'} = 'endit';
  6.     $| = 1;        # command buffering on stdout
  7.     &initterm;
  8.     &inithelp;
  9.     &slurpfile && &pagearray;
  10.  
  11. EndOfMain
  12.  
  13. &endit;
  14.  
  15. ################################################################################
  16.  
  17. sub initterm {
  18.  
  19.     &initscr; &cbreak; &noecho; &scrollok($stdscr, 1);
  20.     &defbell unless defined &bell;
  21.  
  22.     $lines = $LINES; $lines1 = $lines - 1; $lines2 = $lines - 2;
  23.     $cols = $COLS;   $cols1  = $cols  - 1; $cols2  = $cols  - 2;;
  24.  
  25.     $dl = &getcap('dl');
  26.     $al = &getcap('al');
  27.     $ho = &getcap('ho');
  28.     $ce = &getcap('ce');
  29. }
  30.  
  31. sub slurpfile {
  32.     while (<>) {
  33.     s/^(\t+)/'        ' x length($1)/e;
  34.     &expand($_) if /\t/;
  35.     if (length($_) < $cols) {
  36.         push(@lines, $_);
  37.     }
  38.     else {
  39.         while ($_ && $_ ne "\n") {
  40.         push(@lines, substr($_,0,$cols));
  41.         substr($_,0,$cols) = '';
  42.         }
  43.     }
  44.     }
  45.     1;
  46. }
  47.  
  48. sub drawscreen {
  49.     &move(0,0);
  50.     for ($line .. $line + $lines2) {
  51.     &addstr($lines[$_]);
  52.     }
  53.     &clrtobot;
  54.     &percent;
  55.     &refresh;
  56. }
  57.  
  58. sub expand {
  59.     while (($off = index($_[0],"\t")) >= 0) {
  60.     substr($_[0], $off, 1) = ' ' x (8 - $off % 8);
  61.     }
  62. }
  63.  
  64. sub pagearray {
  65.     $line = 0;
  66.  
  67.     $| = 1;
  68.  
  69.     for (&drawscreen;;&drawscreen) {
  70.  
  71.     $ch = &getch;
  72.     $ch = 'j' if $ch eq "\n";
  73.  
  74.     if ($ch eq ' ') {
  75.         last if $percent >= 100;
  76.         &move(0,0);
  77.         $line += $lines1;
  78.     }
  79.     elsif ($ch eq 'b') {
  80.         $line -= $lines1;
  81.         &move(0,0);
  82.         $line = 0 if $line < 0;
  83.     }
  84.     elsif ($ch eq 'j') {
  85.         next if $percent >= 100;
  86.         $line += 1;
  87.         if ($dl && $ho) {
  88.         print $ho, $dl;
  89.         &mvcur(0,0,$lines2,0);
  90.         print $ce,$lines[$line+$lines2],$ce;
  91.         &wmove($curscr,0,0);
  92.         &wdeleteln($curscr);
  93.         &wmove($curscr,$lines2,0);
  94.         &waddstr($curscr,$lines[$line+$lines2]);
  95.         }
  96.         &wmove($stdscr,0,0);
  97.         &wdeleteln($stdscr);
  98.         &wmove($stdscr,$lines2,0);
  99.         &waddstr($stdscr,$lines[$line+$lines2]);
  100.         &percent;
  101.         &refresh;
  102.         redo;
  103.     }
  104.     elsif ($ch eq 'k') {
  105.         next if $line <= 0;
  106.         $line -= 1;
  107.         if ($al && $ho && $ce) {
  108.         print $ho, $al, $ce, $lines[$line];
  109.         &wmove($curscr,0,0);
  110.         &winsertln($curscr);
  111.         &waddstr($curscr,$lines[$line]);
  112.         }
  113.         &wmove($stdscr,0,0);
  114.         &winsertln($stdscr);
  115.         &waddstr($stdscr,$lines[$line]);
  116.         &percent;
  117.         &refresh;
  118.         redo;
  119.     }
  120.     elsif ($ch eq "\f") {
  121.         &clear;
  122.     }
  123.     elsif ($ch eq 'q') {
  124.         last;
  125.     }
  126.     elsif ($ch eq 'h') {
  127.         &clear;
  128.         &help;
  129.         &clear;
  130.     }
  131.     else {
  132.         &bell;
  133.     }
  134.     }
  135. }
  136.  
  137. sub defbell {
  138.     eval q#
  139.     sub bell {
  140.         print "\007";
  141.     }
  142.     #;
  143. }
  144.  
  145. sub help {
  146.     local(*lines) = *helplines;
  147.     local($line);
  148.     &pagearray;
  149. }
  150.  
  151. sub inithelp {
  152.     @helplines = split(/\n/,<<'EOT');
  153.  
  154.   h              Display this help.
  155.   q              Exit.
  156.  
  157.   SPACE          Forward  screen.
  158.   b              Backward screen.
  159.   j, CR          Forward  1 line.
  160.   k              Backward 1 line.
  161.   FF             Repaint screen.
  162. EOT
  163.     for (@helplines) {
  164.     s/$/\n/;
  165.     }
  166. }
  167.  
  168. sub percent {
  169.     &standout;
  170.       $percent = int(($line + $lines1) * 100 / @lines);
  171.       &move($lines1,0);
  172.       &addstr("($percent%)");
  173.     &standend;
  174.     &clrtoeol;
  175. }
  176.  
  177. sub endit {
  178.     &move($lines1,0);
  179.     &clrtoeol;
  180.     &refresh;
  181.     &endwin;
  182.  
  183.     if ($@) {
  184.     print "";                # force flush of stdout
  185.     $@ =~ s/\(eval\)/$0/ && $@ =~ s/line (\d+)/'line ' . ($1 + $evaloffset)/e;
  186.     die $@;
  187.     }
  188.  
  189.     exit;
  190. }
  191.